home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database Designers / Rational Rose 2000 / Rational Setup.EXE / common / lib / auto / Getopt / Long / Configure.al < prev    next >
Encoding:
Text File  |  1999-01-26  |  2.0 KB  |  74 lines

  1. # NOTE: Derived from ../LIB\Getopt\Long.pm.
  2. # Changes made here will be lost when autosplit again.
  3. # See AutoSplit.pm.
  4. package Getopt::Long;
  5.  
  6. #line 756 "../LIB\Getopt\Long.pm (autosplit into ..\lib\auto/Getopt\Long/Configure.al)"
  7. # Getopt::Long Configuration.
  8. sub Configure (@) {
  9.     my (@options) = @_;
  10.     my $opt;
  11.     foreach $opt ( @options ) {
  12.     my $try = lc ($opt);
  13.     my $action = 1;
  14.     if ( $try =~ /^no_?(.*)$/s ) {
  15.         $action = 0;
  16.         $try = $+;
  17.     }
  18.     if ( $try eq 'default' or $try eq 'defaults' ) {
  19.         ConfigDefaults () if $action;
  20.     }
  21.     elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
  22.         $autoabbrev = $action;
  23.     }
  24.     elsif ( $try eq 'getopt_compat' ) {
  25.         $getopt_compat = $action;
  26.     }
  27.     elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
  28.         $ignorecase = $action;
  29.     }
  30.     elsif ( $try eq 'ignore_case_always' ) {
  31.         $ignorecase = $action ? 2 : 0;
  32.     }
  33.     elsif ( $try eq 'bundling' ) {
  34.         $bundling = $action;
  35.     }
  36.     elsif ( $try eq 'bundling_override' ) {
  37.         $bundling = $action ? 2 : 0;
  38.     }
  39.     elsif ( $try eq 'require_order' ) {
  40.         $order = $action ? $REQUIRE_ORDER : $PERMUTE;
  41.     }
  42.     elsif ( $try eq 'permute' ) {
  43.         $order = $action ? $PERMUTE : $REQUIRE_ORDER;
  44.     }
  45.     elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
  46.         $passthrough = $action;
  47.     }
  48.     elsif ( $try =~ /^prefix=(.+)$/ ) {
  49.         $genprefix = $1;
  50.         # Turn into regexp. Needs to be parenthesized!
  51.         $genprefix = "(" . quotemeta($genprefix) . ")";
  52.         eval { '' =~ /$genprefix/; };
  53.         Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
  54.     }
  55.     elsif ( $try =~ /^prefix_pattern=(.+)$/ ) {
  56.         $genprefix = $1;
  57.         # Parenthesize if needed.
  58.         $genprefix = "(" . $genprefix . ")" 
  59.           unless $genprefix =~ /^\(.*\)$/;
  60.         eval { '' =~ /$genprefix/; };
  61.         Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
  62.     }
  63.     elsif ( $try eq 'debug' ) {
  64.         $debug = $action;
  65.     }
  66.     else {
  67.         Croak ("Getopt::Long: unknown config parameter \"$opt\"")
  68.     }
  69.     }
  70. }
  71.  
  72. # end of Getopt::Long::Configure
  73. 1;
  74.